The X-Philes (2nd Revision)/The X-Philes Number 1 (1995).iso/xphiles/hp48_1/pubdom.tar/pubdom/e_vogel/inct

Text File | 1990-05-19 | 4KB | 60 lines

%%HP: T(3)A(D)F(.);                        @ INCT: add a temperature increment
                                           @ to a point on a temperature scale,
                                           @ and get a new point.
\<<                                        @ tpt1 tinc ->
  \-> tpt1 tinc                            @ Save arguments (user-defined
                                           @ function structure allows INCT
                                           @ to be used in an algebraic)
  \<<                                      @ ->
    tpt1 tinc                              @ Restore arguments
                                           @ tpt1 tinc ->
    IF                                     @ Check for real arguments
      DUP2                                 @ tpt1 tinc tpt1 tinc ->
      TYPE                                 @ tpt1 tinc tpt1 TYPE(tinc) ->
      SWAP TYPE                            @ tpt1 tinc TYPE(tinc) TYPE(tpt1) ->
      +                                    @ Sum will be zero if both real ->
                                           @ tpt1 tinc 0/nonzero ->
    THEN                                   @ Not 0: assume 2 pure temperatures
                                           @ tpt1 tinc ->
                                           @ To check for pure temperatures,
                                           @ call VFTOBJ or VFTERR here
      OBJ\->                               @ Decompose tinc
                                           @ tpt1 N(tinc) U(tinc) ->
      ROT                                  @ N(tinc) U(tinc) tpt1 ->
      OBJ\->                               @ Decompose tpt1
                                           @ N(tinc) U(tinc) N(tpt1) U(tpt1) ->
      \-> ntinc utinc ntpt1 utpt1          @ Save for later
      \<<                                  @ ->
        { '1_\^oC' '1_K' } DUP             @ {K scale} {K scale} ->
        IF                                 @ Test if on same scale
          utpt1 POS SWAP                   @ tpt1 on Kelvin scale?
                                           @ tpt1pos {K scale} ->
          utinc POS                        @ tinc on Kelvin scale?
                                           @ tpt1pos tincpos ->
          OVER                             @ tpt1pos tincpos tpt1pos ->
          XOR                              @ tpt1pos bothpos ->
        THEN                               @ Not on same scale
          1.8                              @ scalefactor=1.8
                                           @ tpt1pos 1.8 ->
          IF                               @ tpt1 on Kelvin scale?
            SWAP                           @ 1.8 tpt1pos ->
          THEN                             @ Yes: scalefactor=1/1.8
            INV                            @ 1/1.8 ->
          END                              @ 1.8 or 1/1.8 ->
        ELSE                               @ On same scale
                                           @ tpt1pos
          DROP 1                           @ scalefactor=1
        END                                @ scalefactor ->
        ntinc *                            @ N(tinc)*scalefactor ->
        ntpt1 +                            @ N(tpt1)+N(tinc)*scalefactor ->
        utpt1 \->UNIT                      @ Build unit object
                                           @ inct ->
      \>>
    ELSE                                   @ 0: 2 reals, so just add
                                           @ tpt1 tinc ->
      +                                    @ tpt1+tinc ->
                                           @ inct ->
    END
  \>>
\>>